home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / VISIMP.ZIP / SPOPUP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-09  |  6KB  |  175 lines
  1. { *************************************************************************** }
  2. {                  V I S U A L  I M P L E M E N T A T I O N                   }
  3. {                            Shadowed Popup Boxes                             }
  4. {                     Pascal Code (C)1993 Bobby R. Wallen                     }
  5. {                            All Rights Reserved                              }
  6. {               Please do not remove my Credits from this file                }
  7. { *************************************************************************** }
  8. unit SPopup;
  9. interface
  10. uses OWindows, Objects, WinTypes;
  11.  
  12. const
  13.      WM_SPOPUP_DONE = WM_USER + 1;
  14.      SPopUp_ShadowWidth  = 16;
  15.      SPopup_ShadowHeight = 16;
  16.      SPopUp_MaxWidth     = 400;
  17.      SPopUp_BrushPattern : array[0..7] of Integer = ( $AA, $55, $AA, $55,
  18.                                                       $AA, $55, $AA, $55 );
  19.  
  20. type
  21.      PSPopUp = ^TSPopUp;
  22.      TSPopUp = object( TWindow )
  23.        ABitmap : HBitmap;
  24.        ABrush  : HBrush;
  25.        ARect : TRect;
  26.        PopText : array[0..1023] of Char;
  27.        constructor Init( AParent: PWindowsObject; oX, oY : Integer;
  28.                          AText: PChar);
  29.        destructor  Done; virtual;
  30.        procedure   CalcRect( var Rect: TRect; AText: PChar ); virtual;
  31.        procedure   GetWindowClass( var AWndClass: TWndClass ); virtual;
  32.        function    GetClassName : PChar ; virtual;
  33.        procedure   WMRButtonDown( var Msg: TMessage ); virtual WM_First + WM_RButtonDown;
  34.        procedure   WMMButtonDown( var Msg: TMessage ); virtual WM_First + WM_MButtonDown;
  35.        procedure   WMLButtonDown( var Msg: TMessage ); virtual WM_First + WM_LButtonDown;
  36.        procedure   WMKeyDown( var Msg: TMessage ); virtual WM_First + WM_KeyDown;
  37.        procedure   WMSysKeyDown( var Msg: TMessage ); virtual WM_First + WM_SysKeyDown;
  38.        procedure   WMNCCalcSize( var Msg: TMessage ); virtual WM_First + WM_NCCalcSize;
  39.        procedure   WMNCPaint( var Msg: TMessage ); virtual WM_First + WM_NCPaint;
  40.        procedure   Paint( PaintDC: HDC; var PaintStruct: TPaintStruct ); virtual;
  41.      end;
  42.  
  43. implementation
  44. uses WinProcs, Strings;
  45.  
  46. procedure TSPopUp.CalcRect;
  47. var
  48.    WinDC: HDC;
  49. begin
  50.      WinDC := CreateDC( 'DISPLAY', nil, nil, nil );
  51.      SelectObject( WinDC, GetStockObject( System_Font ) );
  52.      SetRect( ARect, 0, 0, SPopUp_MaxWidth, 0 );
  53.      DrawText( WinDC, AText, -1, ARect, DT_NoPrefix or DT_WordBreak or DT_CalcRect );
  54.      inc( ARect.Right, 10 );
  55.      DeleteDC( WinDC );
  56. end;
  57.  
  58. procedure TSPopUp.Paint;
  59. begin
  60.      OffsetRect( ARect, SPopUp_ShadowWidth, SPopUp_ShadowHeight );
  61.      DrawText( PaintDC, PopText, -1, ARect, DT_WordBreak or DT_NoPrefix );
  62.      SetFocus( HWindow );
  63.      SetCapture( HWindow );
  64. end;
  65.  
  66.  
  67. procedure TSPopUp.GetWindowClass;
  68. begin
  69.      inherited GetWindowClass( AWndClass );
  70.      AWndClass.hbrBackground := HBrush( Color_Window + 1 );
  71. end;
  72.  
  73. function TSPopUp.GetClassName : PChar;
  74. begin
  75.      GetClassName := 'SPOPUP';
  76. end;
  77.  
  78. procedure TSPopUp.WMNCCalcSize;
  79. var
  80.    lpClientRect : PRect;
  81. begin
  82.      lpClientRect := PRect( Msg.lParam );
  83.      inc( lpClientRect^.Left, 1 );
  84.      inc( lpClientRect^.top, 1 );
  85.      dec( lpClientRect^.Right, SPopUp_ShadowWidth + 1 );
  86.      dec( lpClientRect^.Bottom, SPopUp_ShadowHeight + 1 );
  87. end;
  88.  
  89. procedure TSPopUp.WMNCPaint;
  90. var
  91.    WinDC : HDC;
  92.    Rect : TRect;
  93.    hbrFrame : HBrush;
  94.    hbrOld   : HBrush;
  95. begin
  96.      WinDC := GetWindowDC( HWindow );
  97.      GetWindowRect( HWindow, Rect );
  98.      dec( Rect.Right, Rect.Left );
  99.      dec( Rect.Bottom, Rect.Top );
  100.      Rect.Top := 0;
  101.      Rect.Left := 0;
  102.  
  103.      UnrealizeObject( ABrush );
  104.      hbrOld := SelectObject( WinDC, ABrush );
  105.      PatBlt( WinDC, Rect.Left + SPopUp_ShadowWidth,
  106.              Rect.Bottom - SPopUp_ShadowHeight,
  107.              Rect.Right - SpopUp_ShadowWidth,
  108.              SPopUp_ShadowHeight, $A000C9 );
  109.      PatBlt( WinDC, Rect.Right - SPopUp_ShadowWidth,
  110.              Rect.Top + SPopUp_ShadowHeight,
  111.              SPopUp_ShadowWidth,
  112.              Rect.Bottom, $A000C9 );
  113.      SelectObject( WinDC, hbrOld );
  114.      hbrFrame := CreateSolidBrush( GetSysColor( Color_WindowFrame ) );
  115.      dec( Rect.Right, SPopUp_ShadowWidth );
  116.      dec( Rect.Bottom, SPopUp_ShadowHeight );
  117.      FrameRect( WinDC, Rect, hbrFrame );
  118.      DeleteObject( hbrFrame );
  119.      ReleaseDC( HWindow, WinDC );
  120. end;
  121.  
  122.  
  123. constructor TSPopUp.Init;
  124. begin
  125.      inherited Init( AParent, nil );
  126.      CalcRect( ARect, AText );
  127.      Attr.X := oX;
  128.      Attr.Y := oY;
  129.      Attr.W := ARect.Right + SPopUp_ShadowWidth * 3 - oX;
  130.      Attr.H := ARect.Bottom + SPopUp_ShadowHeight * 3 - oY;
  131.      Attr.Style := WS_CHILD or WS_OVERLAPPEDWINDOW or WS_VISIBLE;
  132.      ABitmap := CreateBitmap( 8, 8, 1, 1, @SPopUp_BrushPattern );
  133.      ABrush  := CreatePatternBrush( ABitmap );
  134.      StrCopy( PopText, AText );
  135.      EnableKBHandler;
  136. end;
  137.  
  138. destructor TSPopUp.Done;
  139. begin
  140.      if ABitmap <> 0 then DeleteObject( ABitmap );
  141.      if ABrush <> 0 then DeleteObject( ABrush );
  142.      inherited Done;
  143. end;
  144.  
  145. procedure TSPopUp.WMRButtonDown;
  146. begin
  147.      ReleaseCapture;
  148.      SendMessage( Parent^.HWindow, WM_SPOPUP_DONE, Msg.wParam, Msg.lParam );
  149. end;
  150.  
  151. procedure TSPopUp.WMMButtonDown;
  152. begin
  153.      ReleaseCapture;
  154.      SendMessage( Parent^.HWindow, WM_SPOPUP_DONE, Msg.wParam, Msg.lParam );
  155. end;
  156.  
  157. procedure TSPopUp.WMLButtonDown;
  158. begin
  159.      ReleaseCapture;
  160.      SendMessage( Parent^.HWindow, WM_SPOPUP_DONE, Msg.wParam, Msg.lParam );
  161. end;
  162.  
  163. procedure TSPopUp.WMKeyDown;
  164. begin
  165.      ReleaseCapture;
  166.      SendMessage( Parent^.HWindow, WM_SPOPUP_DONE, Msg.wParam, Msg.lParam );
  167. end;
  168.  
  169. procedure TSPopUp.WMSysKeyDown;
  170. begin
  171.      ReleaseCapture;
  172.      SendMessage( Parent^.HWindow, WM_SPOPUP_DONE, Msg.wParam, Msg.lParam );
  173. end;
  174.  
  175. end.